TK!2
=v
#1
:n
m
:v
6
:s
i
:c
Number of rows + 1
#2
:n
n
:v
7
:s
i
:c
Number of columns + 1
#3
:n
x
:v
'xx
:s
i
:c
list of row-lists
#4
:n
y
:v
'yy
:s
i
:c
list of column-lists
=u
=l
#1
:n
names
:c
Row names for the Input Data Table
:v
'Bob
'Dan
'Jim
'Ron
'Tom
'ä
E
#2
:n
Bob
:c
1st row of Data Input Table
:v
3
2
5
7
4
2
E
#3
:n
Dan
:c
2nd  "   "   "    "     "
:v
8
2
3
6
5
4
E
#4
:n
Jim
:c
3rd  "   "   "    "     "
:v
6
2
6
7
6
6
E
#5
:n
Ron
:c
4th  "   "   "    "     "
:v
9
1
4
5
4
5
E
#6
:n
Tom
:c
5th  "   "   "    "     "
:v
5
7
8
3
2
3
E
#7
:n
ä
:c
6th  "   "   "    "     "   (sums)
:v
E
#9
:n
xx
:c
Row names for the Working Table
:v
'x01
'x02
'x03
'x04
'x05
'x06
'x07
'x08
'x09
'x10
E
#10
:n
x01
:c
1st row of Working Table
:v
E
#11
:n
x02
:c
2nd  "   "    "      " 
:v
E
#12
:n
x03
:c
3rd  "   "    "      "
:v
E
#13
:n
x04
:c
4th  "   "    "      "
:v
E
#14
:n
x05
:c
5th  "   "    "      "
:v
E
#15
:n
x06
:c
6th  "   "    "      "  (sums)
:v
E
#16
:n
x07
:c
7th  "   "    "      "  (checks)
:v
E
#17
:n
x08
:c
8th  "   "    "      "  (not used)
:v
E
#18
:n
x09
:c
9th  "   "    "      "    "   "
:v
E
#19
:n
x10
:c
10t  "   "    "      "    "   "
:v
E
#21
:n
yy
:c
Row names for the Transposed Working Table
:v
'y01
'y02
'y03
'y04
'y05
'y06
'y07
'y08
'y09
'y10
E
#22
:n
y01
:c
1st row of Transposed Working Table
:v
3
8
6
9
5
31
'solved
E
#23
:n
y02
:c
2nd  "   "      "        "      "
:v
2
2
2
1
7
14
'solved
E
#24
:n
y03
:c
3rd  "   "      "        "      "
:v
5
3
6
4
8
26
'solved
E
#25
:n
y04
:c
4th  "   "      "        "      "
:v
7
6
7
5
3
28
'solved
E
#26
:n
y05
:c
5th  "   "      "        "      "
:v
4
5
6
4
2
21
'solved
E
#27
:n
y06
:c
6th  "   "      "        "      "
:v
2
4
6
5
3
20
'solved
E
#28
:n
y07
:c
7th  "   "      "        "      "
:v
23
28
33
28
28
140
'solved
E
#29
:n
y08
:c
8th  "   "      "        "      "
:v
'solved
'solved
'solved
'solved
'solved
'OK
E
#30
:n
y09
:c
9th  "   "      "        "      "
:v
E
#31
:n
y10
:c
10th "   "      "        "      "
:v
E
#32
:n
month
:c
Legend for the Input Data Table
:v
'Jan
'Feb
'Mar
'Apr
'May
'Jun
'Total
E
=f
#1
:n
blankfill
:c
Solving for missing elements of a balance sheet
:t
Procedure
:i
m,n,X,Y
#2
:n
transpose
:c
Transposing table A into table B
:t
Procedure
:i
A,B
#3
:n
listsum
:c
Backsolvable sum function (modified)
:t
Procedure
:i
R,n,i,C
#4
:n
Mcopy
:c
Copy matrix (i.e. subordinate lists)
:t
Procedure
:i
M1,M2
#5
:n
Mdelete
:c
Delete matrix (i.e. subordinate lists)
:t
Procedure
:i
M
#6
:n
Mblank
:c
Blank matrix (i.e. subordinate lists)
:t
Procedure
:i
M
#1
:n
blankfill
:z
" Description:

" This is the main procedure of a set of procedures for truly 'backsolvable'
" sheet balancing.  The balance table is represented by an  m x n  matrix of
" values complete with a row and a column with sums of columns and rows
" respectively.  The lower rightmost cell contains the grand total.

" Any of (m+1)*(n+1) values may be known or unknown.  The procedure
" 'blankfill' scans through the rows and columns and fills all blank cells
" that can be evaluated.  When any unknown is solved for, the respective row
" or column is marked 'solved in the (m+2)th column or (n+2)th row.  If a sum
" checks out, the row or column is marked 'OK.  If the problem is overdefined
" the discrepancy is displayed instead.  If the problem is underdefined, some
" cells simply remain blank.

" Supporting functions: Mblank, Mcopy, transpose, listsum

call Mblank(X)
call Mcopy('names,X)       " copies the Input Data into the Working Table 
call transpose(X,Y)        " creates the Transposed Working Table

loop: count:= 0                                   " resets success counter
for i=1 to m                                      " scans through the lists
   if or(count(X[i])<n-1,length(X[i])>n) goto next  " nothing to solve
   call listsum(X[i],n,i,Y)                         " solves an equation
   count:= count + 1                                " increment the counter
next: next i
if count=0 return          " no gain, solution finished
(m,n):= (n,m)              "  \  swaps the Working and the Transposed Working
(X,Y):= (Y,X)              "  /  tables (interchanging rows and columns)
goto loop
/E
E
#2
:n
transpose
:z
for j=1 to length(B)
   call blank(B[j])        " blank all B-lists
next j
for i=1 to length(A)
   a:= A[i]
   for j=1 to length(a)
      call listcopy(a,B[j],j,j,i)
   next j
next i
/E
E
#3
:n
listsum
:z
" Description:
" This procedure solves an equation
"                R[1] + R[2] + ... + R[n-1] = R[n]
" for any unknown element of list R, and displays the message 'solved in the
" R[n+1]th element.  If all the  n  elements of the list  R  are known, the
" difference between the left and right hand sides is evaluated.  If it
" is 0, the R[n+1]th element is assigned  'OK .  If it is other than 0, the
" difference is assigned to R[n+1].  For the purpose of solving for unknown
" table elements, the results are also written into the ith column of the
" transposed table C.

sum:= sum(R)
if elt(R,n,'ud)='ud goto last
checksum:= 2*R[n] - sum
if count(R)<n goto find
if checksum=0 then R[n+1]:='OK "else R[n+1]:=-checksum
if checksum<>0 then R[n+1]:= -checksum
C[n+1][i]:= R[n+1]
return
find: for j=1 to n-1
         if elt(R,j,'ud)='ud goto fill
      next j
fill: R[j]:= checksum
      C[j][i]:= checksum     " <<<
      goto mark
last: R[n]:= sum
      C[n][i]:= sum          " <<<
mark: R[n+1]:= 'solved
      C[n+1][i]:= 'solved    " <<<

" <<< added for use with 'blankfill'
/E
E
#4
:n
Mcopy
:z
" This procedure copies subordinate lists of the masterlist M1 into 
" subordinate lists of the masterlist M2.

for i=1 to length(M1)
   call listcopy(M1[i],M2[i])   " error indicates no listname in ith
                                " element of either M1 or M2
next i
/E
E
#5
:n
Mdelete
:z
" This procedure deletes subordinate lists of the master list  M  from the
" List Sheet. The master list remains intact.

for i=1 to length(M)
   call delete(M[i])    " error indicates no listname in ith element of M
next i
/E
E
#6
:n
Mblank
:z
" This procedure blanks (i.e. erases the contents of) the first  n  lists
" named in the master list  M .

for i=1 to length(M)
   call blank(M[i])    " error indicates no listname in ith element of M
next i
/E
E
=r
#1
:r
"  >>>  Solving for missing elements in a balance table  <<<
:s
C
#3
:r
call blankfill(m,n,x,y)
#5
:r
" This model presents a procedure blankfill with a completely backsolvable
:s
C
#6
:r
" balance table.
:s
C
#8
:r
" The purpose of this exercise is threefold.  Firstly, the model may be
:s
C
#9
:r
" useful as is or with small modifications (never mind the salesmen/month
:s
C
#10
:r
" facade).  Secondly, the algorithm mimics to some extent the inner workings
:s
C
#11
:r
" of the Direct Solver, and demonstrates the essence and the power of the TK
:s
C
#12
:r
" concept.  Thirdly, it shows how to stretch the TK concept beyond standard
:s
C
#13
:r
" TK Solver Plus applications using just the currently available features.
:s
C
#15
:r
" U s e :     ==>> Print out these instructions [Home] / P [End] [Enter] <<==
:s
C
#17
:r
" The best start is to bring up the Input Data Table and the Working Table
:s
C
#18
:r
" in the upper and lower windows respectively.  You can do it from here by
:s
C
#19
:r
" the command string  = T > > / W T [DownArrow] > > .  Next, press  F9  and
:s
C
#20
:r
" watch the input data get copied and the results fill in on the Working
:s
C
#21
:r
" Table.  The unknowns are just the sums of rows and columns.
:s
C
#23
:r
" Now the thrill: Switch (;) to the Input Data Table and type a new total
:s
C
#24
:r
" quota 150 in the  ä,Total  field.  It means the salesmen will have to do 
:s
C
#25
:r
" better.  So, enter  30  as Dan's, Ron's and Tom's totals.  Also, enter a
:s
C
#26
:r
" total of 33 for Jim and leave Bob's total blank.  Next, enter 31, 26 and
:s
C
#27
:r
" 28 (i.e. the sums for the "good" months of January, March and April) in
:s
C
#28
:r
" the appropriate fields in the ä row, leaving the ä fields for February,
:s
C
#29
:r
" May and June blank.  Finally, blank all the fields of the "bad" month of
:s
C
#30
:r
" February except for Tom's 7, and solve (F9).
:s
C
#32
:r
" A new solution comes up in the bottom Working Table.  The -2 in the last
:s
C
#33
:r
" row in the February column indicates a shortage in February, apparently in
:s
C
#34
:r
" Tom's results.  You can enter 26 as a total for February, and blank Bob's
:s
C
#35
:r
" and Tom's April numbers to make space for change.  New solution shows a
:s
C
#36
:r
" surplus of 2 in Bob's and ä's row, which is O.K. to live with.
:s
C
#38
:r
" The procedure 'blankfill' and the model may be modified in many ways.  One 
:s
C
#39
:r
" can expand or reduce the table by changing  m  and  n  in the Variable
:s
C
#40
:r
" Sheet and adjusting the contents of the Table Subsheets and List Sheet.
:s
C
#41
:r
" It is also possible to combine the Input Data Table and Working Table,
:s
C
#42
:r
" although in that case one cannot see the inputs and results separately.
:s
C
=p
=t
#1
:n
Table_0
:s
Screen
:v
Horizontal
:f
1
:r
""
:c
""
:t
"Input Data Table"
:u
#1
:l
month
:w
8
:h
""
#2
:l
Bob
:w
8
:h
""
#3
:l
Dan
:w
8
:h
""
#4
:l
Jim
:w
8
:h
""
#5
:l
Ron
:w
8
:h
""
#6
:l
Tom
:w
8
:h
""
#7
:l
ä
:w
8
:h
""
E
#2
:n
Table_X
:s
Screen
:v
Horizontal
:f
1
:r
""
:c
""
:t
"Working Table"
:u
#1
:l
month
:w
8
:h
""
#2
:l
x01
:w
8
:h
"r| B"
#3
:l
x02
:w
8
:h
"e| D"
#4
:l
x03
:w
8
:h
"s| J"
#5
:l
x04
:w
8
:h
"u| R"
#6
:l
x05
:w
8
:h
"l| T"
#7
:l
x06
:w
8
:h
"t| ä"
#8
:l
x07
:w
8
:h
"check"
E
#3
:n
Table_Y
:s
Screen
:v
Horizontal
:f
1
:r
""
:c
""
:t
"Transposed Working Table"
:u
#1
:l
y01
:w
8
:h
""
#2
:l
y02
:w
8
:h
""
#3
:l
y03
:w
8
:h
""
#4
:l
y04
:w
8
:h
""
#5
:l
y05
:w
8
:h
""
#6
:l
y06
:w
8
:h
""
#7
:l
y07
:w
8
:h
""
E
=n
=g
#1
:c
.000001
:i
10
:v
Yes
:l
60
:f
66
:m
0
:w
80
:b
Yes
:a
Yes
:r
No
:h
No
:t
1
:n
Yes
:d
LPT1
%Tr,f,0,1,0,1,0
